home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s3.arc / PIBSCRN1.MOD < prev    next >
Text File  |  1987-04-09  |  54KB  |  1,060 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       PIBSCREN.PAS --- Screen Handling Routines for Turbo Pascal     *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*                                                                      *)
  7. (*  Date:    Version 1.0: January, 1985 (Part of PibMenus)              *)
  8. (*           Version 1.1: March, 1985   (Part of PibMenus)              *)
  9. (*           Version 1.2: May, 1985     (Part of PibMenus)              *)
  10. (*           Version 2.0: June, 1985    (Split from PibMenus)           *)
  11. (*           Version 3.0: October, 1985                                 *)
  12. (*           Version 3.1: October, 1985                                 *)
  13. (*           Version 3.2: November, 1985                                *)
  14. (*           Version 4.0: March, 1987                                   *)
  15. (*                                                                      *)
  16. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  17. (*           Note:  I have checked these on Zenith 151s under           *)
  18. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  19. (*                  Version 4.0 provides automatic support for          *)
  20. (*                  SoftLogic's DoubleDos and TopView-like systems.     *)
  21. (*                                                                      *)
  22. (*  History: These routines provide a simple windowing facility for     *)
  23. (*           Turbo Pascal as well as routines for direct access to the  *)
  24. (*           screen memory area.                                        *)
  25. (*                                                                      *)
  26. (*           The windowing facility provides windows similar to those   *)
  27. (*           implemented in QMODEM by John Friel III.                   *)
  28. (*                                                                      *)
  29. (*           Version 1.0 of these routines formed part of the           *)
  30. (*           PIBMENUS.PAS include file.  These routines were split off  *)
  31. (*           into a separate PIBSCREN.PAS file at version 2.0.          *)
  32. (*                                                                      *)
  33. (*           Starting with version 3.2, PibScren uses a (hopefully)     *)
  34. (*           version-independent method for ascertaining the size       *)
  35. (*           of the current window.  The method relies on the 1-pass    *)
  36. (*           construction of Turbo, so that the standard built-in       *)
  37. (*           procedure WINDOW can be replaced by one defined here, and  *)
  38. (*           the built-in version then referred to by the name          *)
  39. (*           TurboWindow.                                               *)
  40. (*                                                                      *)
  41. (*           Version 4.0 adds DoubleDos, DesqView, and TopView compati- *)
  42. (*           bility.  MS Windows is supported via TopView emulation.    *)
  43. (*           Many thanks to Barry Kasindorf and Gary Saxer for their    *)
  44. (*           assistance with the DesqView interface.                    *)
  45. (*                                                                      *)
  46. (*           Suggestions for improvements or corrections are welcome.   *)
  47. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  48. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  49. (*                                                                      *)
  50. (*           If you use this code in your own programs, please be nice  *)
  51. (*           and give all of us credit.                                 *)
  52. (*                                                                      *)
  53. (*----------------------------------------------------------------------*)
  54. (*                                                                      *)
  55. (*    Note that code for stacked windows is available here.  You may    *)
  56. (*    want to modify this to use compile-time window spaces, or remove  *)
  57. (*    the current push-down stack structure.                            *)
  58. (*                                                                      *)
  59. (*----------------------------------------------------------------------*)
  60.  
  61. (*----------------------------------------------------------------------*)
  62. (*           Turbo_Window -- allow access to original Turbo window      *)
  63. (*----------------------------------------------------------------------*)
  64.  
  65. PROCEDURE Turbo_Window( X1, Y1, X2, Y2 : INTEGER );
  66.  
  67. (*----------------------------------------------------------------------*)
  68. (*                                                                      *)
  69. (*     Procedure:  Turbo_Window                                         *)
  70. (*                                                                      *)
  71. (*     Purpose:    Allows access to built-in Turbo procedure WINDOW     *)
  72. (*                 after Window is re-defined below.                    *)
  73. (*                                                                      *)
  74. (*----------------------------------------------------------------------*)
  75.  
  76. VAR
  77.    SLen : INTEGER;
  78.  
  79. BEGIN (* Turbo_Window *)
  80.  
  81.    Window( X1, Y1, X2, Y2 );
  82.  
  83.    Mem[CSeg:Turbo_Screen_Length] := Y2;
  84.  
  85.    CloneCodeSegment( TurboRunDataStart , TurboRunDataLength );
  86.  
  87. END   (* Turbo_Window *);
  88.  
  89. (*----------------------------------------------------------------------*)
  90. (*          Window --- Redefines Turbo's built-in WINDOW procedure      *)
  91. (*----------------------------------------------------------------------*)
  92.  
  93. PROCEDURE Window( X1, Y1, X2, Y2 : INTEGER );
  94.  
  95. (*----------------------------------------------------------------------*)
  96. (*                                                                      *)
  97. (*     Procedure:  Window                                               *)
  98. (*                                                                      *)
  99. (*     Purpose:    Redefines built-in Turbo procedure WINDOW so that    *)
  100. (*                 we can keep track of window boundaries.              *)
  101. (*                                                                      *)
  102. (*----------------------------------------------------------------------*)
  103.  
  104. BEGIN (* Window *)
  105.  
  106.    Turbo_Window( X1, Y1, X2, Y2 );
  107.  
  108.    Upper_Left_Column  := X1;
  109.    Upper_Left_Row     := Y1;
  110.    Lower_Right_Column := X2;
  111.    Lower_Right_Row    := Y2;
  112.  
  113. END   (* Window *);
  114.  
  115. (*----------------------------------------------------------------------*)
  116. (*    Color_Screen_Active --- Determine if color or mono screen         *)
  117. (*----------------------------------------------------------------------*)
  118.  
  119. FUNCTION Color_Screen_Active;
  120.  
  121. (*----------------------------------------------------------------------*)
  122. (*                                                                      *)
  123. (*     Function:   Color_Screen_Active                                  *)
  124. (*                                                                      *)
  125. (*     Purpose:    Determines if color or mono screen active            *)
  126. (*                                                                      *)
  127. (*     Calling Sequence:                                                *)
  128. (*                                                                      *)
  129. (*        Color_Active := Color_Screen_Active : BOOLEAN;                *)
  130. (*                                                                      *)
  131. (*           Color_Active --- set to TRUE if the color screen is        *)
  132. (*                            active, FALSE if the mono screen is       *)
  133. (*                            active.                                   *)
  134. (*                                                                      *)
  135. (*     Calls:   INTR                                                    *)
  136. (*                                                                      *)
  137. (*----------------------------------------------------------------------*)
  138.  
  139. VAR
  140.    Regs : RegPack;
  141.  
  142. BEGIN  (* Color_Screen_Active *)
  143.  
  144.    Regs.Ax := 15 SHL 8;
  145.  
  146.    INTR( $10 , Regs );
  147.  
  148.    Color_Screen_Active := ( Regs.Al <> 7 );
  149.  
  150. End    (* Color_Screen_Active *);
  151.  
  152. (*----------------------------------------------------------------------*)
  153. (*     Current_Video_Mode --- Determine current video mode setting      *)
  154. (*----------------------------------------------------------------------*)
  155.  
  156. FUNCTION Current_Video_Mode: INTEGER;
  157.  
  158. (*----------------------------------------------------------------------*)
  159. (*                                                                      *)
  160. (*     Function:   Current_Video_Mode                                   *)
  161. (*                                                                      *)
  162. (*     Purpose:    Gets current video mode setting from system          *)
  163. (*                                                                      *)
  164. (*     Calling Sequence:                                                *)
  165. (*                                                                      *)
  166. (*        Current_Mode := Current_Video_Mode : INTEGER;                 *)
  167. (*                                                                      *)
  168. (*           Current_Mode --- set to integer representing current       *)
  169. (*                            video mode inherited from system.         *)
  170. (*                                                                      *)
  171. (*     Calls:   INTR                                                    *)
  172. (*                                                                      *)
  173. (*----------------------------------------------------------------------*)
  174.  
  175. VAR
  176.    Regs : RegPack;
  177.  
  178. BEGIN  (* Current_Video_Mode *)
  179.  
  180.    Regs.Ax := 15 SHL 8;
  181.  
  182.    INTR( $10 , Regs );
  183.  
  184.    Current_Video_Mode := Regs.Al;
  185.  
  186. END    (* Current_Video_Mode *);
  187.  
  188. (*----------------------------------------------------------------------*)
  189. (*     EGA_Installed  ---  Test if Enhanced Graphics Adapter installed  *)
  190. (*----------------------------------------------------------------------*)
  191.  
  192. FUNCTION EGA_Installed : BOOLEAN;
  193.  
  194. (*----------------------------------------------------------------------*)
  195. (*                                                                      *)
  196. (*     Function:   EGA_Installed                                        *)
  197. (*                                                                      *)
  198. (*     Purpose:    Checks if Enhanced Graphics Adapter is installed.    *)
  199. (*                                                                      *)
  200. (*     Calling Sequence:                                                *)
  201. (*                                                                      *)
  202. (*        EGA_There := EGA_Installed : BOOLEAN;                         *)
  203. (*                                                                      *)
  204. (*           EGA_There --- TRUE if EGA installed                        *)
  205. (*                                                                      *)
  206. (*     Calls:   INTR                                                    *)
  207. (*                                                                      *)
  208. (*----------------------------------------------------------------------*)
  209.  
  210. VAR
  211.    Regs : RegPack;
  212.  
  213. BEGIN  (* EGA_Installed *)
  214.                                    (* Determine if EGA installed       *)
  215.    Regs.AH := $12;
  216.    Regs.BX := $FF10;
  217.    INTR( $10 , Regs );
  218.  
  219.    IF ( Regs.BH = $FF ) THEN       (* EGA not installed *)
  220.       EGA_Installed := FALSE
  221.    ELSE IF ( Regs.CL = 9 ) THEN
  222.       BEGIN (* EGA present with enhanced display *)
  223.          EGA_Installed := TRUE;
  224.       END
  225.    ELSE IF ( Regs.CL = 13 ) THEN
  226.       BEGIN (* EGA present with monochrome display *)
  227.          EGA_Installed := TRUE;
  228.       END
  229.    ELSE (* EGA present but with old color display  *)
  230.       EGA_Installed := FALSE;
  231.  
  232. END    (* EGA_Installed *);
  233.  
  234. (*----------------------------------------------------------------------*)
  235. (*        Get_Screen_Address --- Get address of current screen          *)
  236. (*----------------------------------------------------------------------*)
  237.  
  238. PROCEDURE Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );
  239.  
  240. (*----------------------------------------------------------------------*)
  241. (*                                                                      *)
  242. (*     Procedure:  Get_Screen_Address                                   *)
  243. (*                                                                      *)
  244. (*     Purpose:    Gets screen address for current type of display      *)
  245. (*                                                                      *)
  246. (*     Calling Sequence:                                                *)
  247. (*                                                                      *)
  248. (*        Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );         *)
  249. (*                                                                      *)
  250. (*           Actual_Screen --- pointer whose value receives the         *)
  251. (*                             current screen address.                  *)
  252. (*                                                                      *)
  253. (*     Calls:   Color_Screen_Active                                     *)
  254. (*              PTR                                                     *)
  255. (*              Get_Virtual_Screen_Address                              *)
  256. (*              TimeSharingActive                                       *)
  257. (*                                                                      *)
  258. (*----------------------------------------------------------------------*)
  259.  
  260. VAR
  261.    Regs: RegPack;
  262.  
  263. BEGIN  (* Get_Screen_Address *)
  264.                                    (* Check if timesharing active.   *)
  265.    IF TimeSharingActive THEN
  266.       CASE MultiTasker OF
  267.          DoubleDos:  BEGIN
  268.                         Regs.Ax := $EC00;
  269.                         MsDos( Regs );
  270.                         Actual_Screen := PTR( Regs.Es, 0 );
  271.                      END;
  272.          TaskView,
  273.          TopView,
  274.          MSWindows,
  275.          DesqView:   IF ( Current_Video_Mode <> HiRes_GraphMode) THEN
  276.                         Actual_Screen := DesqView_Screen
  277.                      ELSE
  278.                         Actual_Screen := PTR( Color_Screen_Address , 0 );
  279.          ELSE;
  280.       END
  281.    ELSE
  282.       IF Color_Screen_Active THEN
  283.          Actual_Screen := PTR( Color_Screen_Address , 0 )
  284.       ELSE
  285.          Actual_Screen := PTR( Mono_Screen_Address , 0 );
  286.  
  287. END    (* Get_Screen_Address *);
  288.  
  289. (*----------------------------------------------------------------------*)
  290. (*        Get_Rows_For_EGA  --- Get # of rows in display for EGA        *)
  291. (*----------------------------------------------------------------------*)
  292.  
  293. FUNCTION Get_Rows_For_EGA : INTEGER;
  294.  
  295. VAR
  296.    Regs: RegPack;
  297.  
  298. BEGIN (* Get_Rows_For_EGA *)
  299.                                    (* Get # of rows in current EGA display *)
  300.    Regs.AH := $11;
  301.    Regs.AL := $30;
  302.    Regs.BH := 0;
  303.  
  304.    INTR( $10 , Regs );
  305.  
  306.    IF ( Regs.DL > 0 ) THEN
  307.       Get_Rows_For_EGA := SUCC( Regs.DL )
  308.    ELSE
  309.       Get_Rows_For_EGA := 25;
  310.  
  311. END   (* Get_Rows_For_EGA *);
  312.  
  313. (*----------------------------------------------------------------------*)
  314. (*                Video Display Control Routines                        *)
  315. (*----------------------------------------------------------------------*)
  316. (*                                                                      *)
  317. (*       RvsVideoOn  --- Turn On Reverse Video                          *)
  318. (*       RvsVideoOff --- Turn Off Reverse Video                         *)
  319. (*                                                                      *)
  320. (*----------------------------------------------------------------------*)
  321.  
  322. PROCEDURE RvsVideoOn( Foreground_Color, Background_Color : INTEGER );
  323.  
  324. BEGIN (* RvsVideoOn *)
  325.  
  326.    TextColor     ( Background_color );
  327.    TextBackGround( Foreground_color );
  328.  
  329. END   (* RvsVideoOn *);
  330.  
  331. (*----------------------------------------------------------------------*)
  332.  
  333. PROCEDURE RvsVideoOff( Foreground_Color, Background_Color : INTEGER );
  334.  
  335. BEGIN (* RvsVideoOff *)
  336.  
  337.    TextColor     ( Foreground_color );
  338.    TextBackGround( Background_color );
  339.  
  340. END   (* RvsVideoOff *);
  341.  
  342. (*----------------------------------------------------------------------*)
  343. (*                Cursor Display Control Routines                       *)
  344. (*----------------------------------------------------------------------*)
  345. (*                                                                      *)
  346. (*       CursorOn    --- Turn On Cursor                                 *)
  347. (*       CursorOff   --- Turn Off Cursor                                *)
  348. (*       CursorGet   --- Get current cursor type                        *)
  349. (*       CursorSet   --- Set cursor type                                *)
  350. (*                                                                      *)
  351. (*----------------------------------------------------------------------*)
  352.  
  353. PROCEDURE CursorOn;
  354.  
  355. VAR
  356.    Regs: RegPack;
  357.    I   : INTEGER;
  358.    Rows: INTEGER;
  359.  
  360. BEGIN (* CursorOn *)
  361.  
  362.    IF EGA_Installed THEN
  363.       BEGIN
  364.                                    (* Get # of rows in current EGA display *)
  365.          Rows := Get_Rows_For_EGA;
  366.  
  367.                                    (* Select underline based upon # lines *)
  368.          CASE Rows OF
  369.             25: Regs.Cx := $0607;
  370.             35: Regs.Cx := $0800;
  371.             ELSE
  372.                 Regs.Cx := $0600;
  373.          END (* CASE *);
  374.  
  375.          IF ( Rows > 25 ) THEN
  376.             BEGIN
  377.                I := Mem[$0000:$0487];
  378.                Mem[$0000:$0487] := I OR 1;
  379.             END;
  380.  
  381.          Regs.Ax := $0100;
  382.  
  383.          INTR( $10, Regs );
  384.  
  385.          IF ( Rows > 25 ) THEN
  386.             Mem[$0000:$0487] := I;
  387.  
  388.       END
  389.    ELSE
  390.       BEGIN
  391.                                             (* Change cursor back to underline *)
  392.          Regs.Ax := $0100;
  393.  
  394.          IF Current_Video_Mode = 7 THEN
  395.             Regs.Cl := 13
  396.          ELSE
  397.             Regs.Cl := 7;
  398.  
  399.          Regs.Ch := PRED( Regs.Cl );
  400.  
  401.          INTR( $10, Regs );
  402.  
  403.       END;
  404.  
  405. END   (* CursorOn *);
  406.  
  407. (*----------------------------------------------------------------------*)
  408.  
  409. PROCEDURE CursorOff;
  410.  
  411. VAR
  412.    Regs: RegPack;
  413.  
  414. BEGIN (* CursorOff *)
  415.                                    (* Make cursor invisible *)
  416.    Regs.Ax := $0100;
  417.    Regs.Ch := 32;
  418.  
  419.    INTR( $10, Regs );
  420.  
  421. END   (* CursorOff *);
  422.  
  423. (*----------------------------------------------------------------------*)
  424.  
  425. PROCEDURE CursorGet( VAR Current_Cursor : INTEGER );
  426.  
  427. VAR
  428.    Regs: RegPack;
  429.  
  430. BEGIN (* CursorGet *)
  431.                                    (* Get current cursor type *)
  432.    Regs.Ax := $0300;
  433.    Regs.Bh := 0;
  434.  
  435.    INTR( $10, Regs );
  436.  
  437.    CASE Regs.CX of
  438.       $0067 : Current_Cursor := $0607;    (* Compaq's bug *)
  439.       $0607 : IF Current_Video_Mode = 7 THEN
  440.                  Current_Cursor := $0C0D  (* IBM's bug    *)
  441.               ELSE
  442.                  Current_Cursor := $0607;
  443.       ELSE    Current_Cursor := Regs.CX;
  444.    END;
  445.  
  446. END   (* CursorGet *);
  447.  
  448. (*----------------------------------------------------------------------*)
  449.  
  450. PROCEDURE CursorSet( New_Cursor_Type : INTEGER );
  451.  
  452. VAR
  453.    Regs: RegPack;
  454.    I   : INTEGER;
  455.    Rows: INTEGER;
  456.  
  457. BEGIN (* CursorSet *)
  458.                                    (* Set cursor *)
  459.    Regs.Ax := $0100;
  460.    Regs.Cx := New_Cursor_Type;
  461.  
  462.    IF EGA_Installed THEN
  463.       BEGIN
  464.  
  465.          Rows := Get_Rows_For_EGA;
  466.  
  467.          IF ( Rows > 25 ) THEN
  468.             BEGIN
  469.                I := Mem[$0000:$0487];
  470.                Mem[$0000:$0487] := I OR 1;
  471.             END;
  472.  
  473.          INTR( $10, Regs );
  474.  
  475.          IF ( Rows > 25 ) THEN
  476.             Mem[$0000:$0487] := I;
  477.  
  478.       END
  479.    ELSE
  480.       INTR( $10, Regs );
  481.  
  482. END   (* CursorSet *);
  483.  
  484. (*----------------------------------------------------------------------*)
  485. (*            Upper_Left ---  Upper Position of current window          *)
  486. (*----------------------------------------------------------------------*)
  487.  
  488. PROCEDURE Upper_Left( VAR X1, Y1 : INTEGER );
  489.  
  490. (*----------------------------------------------------------------------*)
  491. (*                                                                      *)
  492. (*     Procedure:   Upper_Left                                          *)
  493. (*                                                                      *)
  494. (*     Purpose:     Returns upper position of current TURBO window      *)
  495. (*                                                                      *)
  496. (*     Calling Sequence:                                                *)
  497. (*                                                                      *)
  498. (*        Upper_Left( VAR X1, Y1 : INTEGER );                           *)
  499. (*                                                                      *)
  500. (*           X1   --- returned upper left column                        *)
  501. (*           Y1   --- returned upper left row                           *)
  502. (*                                                                      *)
  503. (*     Calls:   None                                                    *)
  504. (*                                                                      *)
  505. (*----------------------------------------------------------------------*)
  506.  
  507. BEGIN  (* Upper_Left *)
  508.  
  509.     Y1 := Upper_Left_Row;          (* get Row *)
  510.     X1 := Upper_Left_Column        (* get Column *)
  511.  
  512. END    (* Upper_Left *);
  513.  
  514. (*----------------------------------------------------------------------*)
  515. (*                Set/Reset Text Color Routines                         *)
  516. (*----------------------------------------------------------------------*)
  517. (*                                                                      *)
  518. (*   These routines set and reset the global text foreground and        *)
  519. (*   background colors.                                                 *)
  520. (*                                                                      *)
  521. (*----------------------------------------------------------------------*)
  522.  
  523.                    (* Global Text Color Variables *)
  524.  
  525. PROCEDURE Set_Global_Colors( ForeGround, BackGround : INTEGER );
  526.  
  527. (*----------------------------------------------------------------------*)
  528. (*                                                                      *)
  529. (*     Procedure:  Set_Global_Colors                                    *)
  530. (*                                                                      *)
  531. (*     Purpose:    Sets global text foreground, background colors.      *)
  532. (*                                                                      *)
  533. (*     Calling Sequence:                                                *)
  534. (*                                                                      *)
  535. (*        Set_Global_Colors( ForeGround, BackGround : INTEGER );        *)
  536. (*                                                                      *)
  537. (*           ForeGround --- Default foreground color                    *)
  538. (*           BackGround --- Default background color                    *)
  539. (*                                                                      *)
  540. (*     Calls:   TextColor                                               *)
  541. (*              TextBackGround                                          *)
  542. (*                                                                      *)
  543. (*----------------------------------------------------------------------*)
  544.  
  545. VAR
  546.    My_Blink : INTEGER;
  547.  
  548. BEGIN  (* Set_Global_Colors *)
  549.  
  550.    Global_ForeGround_Color := ForeGround;
  551.    Global_BackGround_Color := BackGround;
  552.  
  553.    IF ( ForeGround > 15 ) THEN
  554.       BEGIN
  555.          ForeGround := ForeGround - 16;
  556.          My_Blink   := 8;
  557.       END
  558.    ELSE
  559.       My_Blink := 0;
  560.  
  561.    Global_Text_Attribute   := ( ( BackGround AND 7 ) OR My_Blink ) SHL 4 +
  562.                                 ForeGround;
  563.  
  564.    TextColor     ( Global_ForeGround_Color );
  565.    TextBackground( Global_BackGround_Color );
  566.  
  567. END    (* Set_Global_Colors *);
  568.  
  569. (*----------------------------------------------------------------------*)
  570. (*  Reset_Global_Colors --- Reset global foreground, background cols.   *)
  571. (*----------------------------------------------------------------------*)
  572.  
  573. PROCEDURE Reset_Global_Colors;
  574.  
  575. (*----------------------------------------------------------------------*)
  576. (*                                                                      *)
  577. (*     Procedure:  Reset_Global_Colors                                  *)
  578. (*                                                                      *)
  579. (*     Purpose:    Resets text foreground, background colors to global  *)
  580. (*                 defaults.                                            *)
  581. (*                                                                      *)
  582. (*     Calling Sequence:                                                *)
  583. (*                                                                      *)
  584. (*        Reset_Global_Colors;                                          *)
  585. (*                                                                      *)
  586. (*     Calls:   TextColor                                               *)
  587. (*              TextBackGround                                          *)
  588. (*                                                                      *)
  589. (*----------------------------------------------------------------------*)
  590.  
  591. BEGIN  (* Reset_Global_Colors *)
  592.  
  593.    TextColor     ( Global_ForeGround_Color );
  594.    TextBackground( Global_BackGround_Color );
  595.  
  596.    Global_Text_Attribute   := ( Global_BackGround_Color AND 7 ) SHL 4 +
  597.                               Global_ForeGround_Color;
  598.  
  599. END    (* Reset_Global_Colors *);
  600.  
  601. (*----------------------------------------------------------------------*)
  602. (*             Set_Border_Color --- Set global border color             *)
  603. (*----------------------------------------------------------------------*)
  604.  
  605. PROCEDURE Set_Border_Color( The_Border_Color : INTEGER );
  606.  
  607. (*----------------------------------------------------------------------*)
  608. (*                                                                      *)
  609. (*     Procedure:  Set_Border_Color                                     *)
  610. (*                                                                      *)
  611. (*     Purpose:    Sets border color                                    *)
  612. (*                                                                      *)
  613. (*     Calling Sequence:                                                *)
  614. (*                                                                      *)
  615. (*        Set_Border_Color( The_Border_Color : INTEGER );               *)
  616. (*                                                                      *)
  617. (*           The_Border_Color --- the border color                      *)
  618. (*                                                                      *)
  619. (*----------------------------------------------------------------------*)
  620.  
  621. VAR
  622.    Regs: RegPack;
  623.  
  624. BEGIN  (* Set_Border_Color *)
  625.  
  626.    IF ( ( NOT TimeSharingActive ) AND Write_Screen_Memory AND
  627.         ( Current_Video_Mode <> 7 ) ) THEN
  628.       BEGIN
  629.  
  630.          Regs.Ah := $0B;
  631.          Regs.Bh := 0;
  632.          Regs.Bl := The_Border_Color;
  633.  
  634.          INTR( $10 , Regs );
  635.  
  636.          Global_Border_Color := The_Border_Color;
  637.  
  638.       END;
  639.  
  640. END    (* Set_Border_Color *);
  641.  
  642. (*----------------------------------------------------------------------*)
  643. (*    Change_Attributes --- Changes specified number of attributes      *)
  644. (*----------------------------------------------------------------------*)
  645.  
  646. PROCEDURE Change_Attributes( NAttr: INTEGER;
  647.                              X    : INTEGER;
  648.                              Y    : INTEGER;
  649.                              Color: INTEGER );
  650.  
  651. (*----------------------------------------------------------------------*)
  652. (*                                                                      *)
  653. (*     Procedure:  Change_Attributes                                    *)
  654. (*                                                                      *)
  655. (*     Purpose:    Changes specified number of attributes               *)
  656. (*                                                                      *)
  657. (*     Calling Sequence:                                                *)
  658. (*                                                                      *)
  659. (*        Change_Attributes( NAttr : INTEGER;                           *)
  660. (*                           X     : INTEGER;                           *)
  661. (*                           Y     : INTEGER;                           *)
  662. (*                           Color : INTEGER );                         *)
  663. (*                                                                      *)
  664. (*           NAttr  --- number of attributes to change                  *)
  665. (*           (X,Y)  --- starting column and row position to change      *)
  666. (*           Color  --- new attribute                                   *)
  667. (*                                                                      *)
  668. (*----------------------------------------------------------------------*)
  669.  
  670. BEGIN (* Change_Attributes *)
  671.  
  672. INLINE(
  673.                                   {;}
  674.                                   {;  Check if we're using BIOS.}
  675.                                   {;}
  676.   $F6/$06/>WRITE_SCREEN_MEMORY/$01{         TEST  BYTE [>Write_Screen_Memory],1 ;Direct screen write?}
  677.   /$74/$4F                        {         JZ    Bios                          ;No -- go use BIOS}
  678.                                   {;}
  679.                                   {;  Set up for direct screen write.}
  680.                                   {;  Get row position and column positions, and offset in screen buffer.}
  681.                                   {;}
  682.   /$C4/$3E/>DESQVIEW_SCREEN       {         LES     DI,[>DesqView_Screen]       ;Get base address of screen}
  683.   /$8B/$4E/<Y                     {         MOV     CX,[BP+<Y]                  ;CX = Row}
  684.   /$49                            {         DEC     CX                          ;Row to 0..Max_Screen_Line-1 range}
  685.   /$A1/>MAX_SCREEN_COL            {         MOV     AX,[>Max_Screen_Col]        ;Physical screen width}
  686.   /$F7/$E1                        {         MUL     CX                          ;Row * Max_Screen_Col}
  687.   /$8B/$5E/<X                     {         MOV     BX,[BP+<X]                  ;BX = Column}
  688.   /$4B                            {         DEC     BX                          ;Column to 0..Max_Screen_Col-1 range}
  689.   /$01/$D8                        {         ADD     AX,BX                       ;AX = (Row * Max_Screen_Col) + Col}
  690.   /$D1/$E0                        {         SHL     AX,1                        ;Account for attribute bytes}
  691.   /$89/$FB                        {         MOV     BX,DI                       ;Get base offset of screen}
  692.   /$01/$C3                        {         ADD     BX,AX                       ;Add computed offset}
  693.   /$43                            {         INC     BX                          ;Add 1 to point to attribute}
  694.   /$89/$DF                        {         MOV     DI,BX                       ;Move result into DI}
  695.                                   {;}
  696.   /$8B/$8E/>NATTR                 {         MOV     CX,[BP+>NAttr]              ;CX = # attributes to change}
  697.   /$E3/$79                        {         JCXZ    Exit                        ;If string empty, Exit}
  698.                                   {;}
  699.   /$8A/$26/>WAIT_FOR_RETRACE      {         MOV     AH,[<Wait_For_Retrace]      ;AH = retrace flag}
  700.   /$8A/$46/<COLOR                 {         MOV     AL,[BP+<Color]              ;AL = Attribute}
  701.   /$FC                            {         CLD                                 ;Set direction to forward}
  702.   /$D0/$DC                        {         RCR     AH,1                        ;If we don't wait for retrace, ...}
  703.   /$73/$1A                        {         JNC     Mono                        ; use "Mono" routine}
  704.                                   {;}
  705.                                   {;  Color routine -- wait for retraces.}
  706.                                   {;}
  707.   /$BA/>CRT_STATUS                {         MOV     DX,>CRT_Status              ;Point DX to CGA status port}
  708.   /$89/$C3                        {         MOV     BX,AX                       ;Store video word in BX}
  709.                                   {;}
  710.   /$EC                            {WaitNoH: IN      AL,DX                       ;Get 6845 status}
  711.   /$A8/$01                        {         TEST    AL,1                        ;Wait for horizontal}
  712.   /$75/$FB                        {         JNZ     WaitNoH                     ; retrace to finish}
  713.                                   {;}
  714.   /$FA                            {         CLI                                 ;Turn off interrupts}
  715.   /$EC                            {WaitH:   IN      AL,DX                       ;Get 6845 status again}
  716.   /$A8/$01                        {         TEST    AL,1                        ;Wait for horizontal retrace}
  717.   /$74/$FB                        {         JZ      WaitH                       ; to start}
  718.                                   {;}
  719.   /$89/$D8                        {Store:   MOV     AX,BX                       ;Restore attribute}
  720.   /$AA                            {         STOSB                               ;Store attribute (already in AH)}
  721.   /$FB                            {         STI                                 ;Allow interrupts}
  722.   /$47                            {         INC     DI                          ;Skip character byte}
  723.   /$E2/$EE                        {         LOOP    WaitNoH                     ;Go back and do next attribute}
  724.                                   {;}
  725.   /$E9/$53/$00                    {         JMP     Exit                        ;Quit when done}
  726.                                   {;}
  727.                                   {;  Mono routine (used whenever Wait_For_Retrace is False) **}
  728.                                   {;}
  729.   /$AA                            {Mono:    STOSB                               ;Change attribute}
  730.   /$47                            {         INC     DI                          ;Skip character byte}
  731.   /$E2/$FC                        {         LOOP    Mono                        ;Do next attribute}
  732.                                   {;}
  733.   /$E9/$4C/$00                    {         JMP     Exit                        ;Done}
  734.                                   {;}
  735.                                   {;  Use BIOS to change attributes}
  736.                                   {;}
  737.   /$B4/$03                        {Bios:    MOV     AH,3                        ;Get current cursor position}
  738.   /$30/$FF                        {         XOR     BH,BH                       ;Display page 0}
  739.   /$55                            {         PUSH    BP}
  740.   /$CD/$10                        {         INT     $10}
  741.   /$5D                            {         POP     BP}
  742.                                   {;}
  743.   /$52                            {         PUSH    DX                          ;Save current cursor position}
  744.                                   {;}
  745.   /$8B/$8E/>NATTR                 {         MOV     CX,[BP+>Nattr]              ;Get # attributes to change}
  746.   /$E3/$34                        {         JCXZ    Bios3                       ;Skip this stuff if nothing to do}
  747.                                   {;}
  748.   /$8A/$76/<Y                     {         MOV     DH,[BP+<Y]                  ;Get row}
  749.   /$FE/$CE                        {         DEC     DH                          ;Drop by 1 for 0-origin}
  750.   /$8A/$56/<X                     {         MOV     DL,[BP+<X]                  ;Get column}
  751.   /$FE/$CA                        {         DEC     DL                          ;Drop by 1 for 0-origin}
  752.                                   {;}
  753.   /$51                            {Bios1:   PUSH    CX                          ;Save attributes left to do}
  754.   /$52                            {         PUSH    DX                          ;Save row and column}
  755.   /$30/$FF                        {         XOR     BH,BH                       ;Display page 0}
  756.   /$B4/$02                        {         MOV     AH,2                        ;Set cursor position}
  757.   /$55                            {         PUSH    BP}
  758.   /$CD/$10                        {         INT     $10}
  759.   /$B4/$08                        {         MOV     AH,8                        ;Read character at current position}
  760.   /$CD/$10                        {         INT     $10}
  761.   /$5D                            {         POP     BP}
  762.                                   {;}
  763.   /$B4/$09                        {         MOV     AH,9                        ;Rewrite character with new attrib}
  764.   /$8A/$5E/<COLOR                 {         MOV     BL,[BP+<Color]              ;Get attribute}
  765.   /$B9/$01/$00                    {         MOV     CX,1                        ;Write one character}
  766.   /$55                            {         PUSH    BP}
  767.   /$CD/$10                        {         INT     $10}
  768.   /$5D                            {         POP     BP}
  769.                                   {;}
  770.   /$5A                            {         POP     DX                          ;Restore position}
  771.   /$59                            {         POP     CX                          ;Restore count of attribs left}
  772.                                   {;}
  773.   /$FE/$C2                        {         INC     DL                          ;Point to next column}
  774.   /$3A/$16/>MAX_SCREEN_COL        {         CMP     DL,[>Max_Screen_Col]        ;See if we're past end of line}
  775.   /$72/$04                        {         JB      Bios2}
  776.                                   {;}
  777.   /$FE/$C6                        {         INC     DH                          ;If so, increment row}
  778.   /$30/$D2                        {         XOR     DL,DL                       ;and reset column to 0.}
  779.                                   {;}
  780.   /$E2/$D6                        {Bios2:   LOOP    Bios1                       ;Loop if more attribs to change}
  781.                                   {;}
  782.   /$5A                            {Bios3:   POP     DX                          ;Restore original cursor position}
  783.   /$30/$FF                        {         XOR     BH,BH}
  784.   /$B4/$02                        {         MOV     AH,2}
  785.   /$55                            {         PUSH    BP}
  786.   /$CD/$10                        {         INT     $10}
  787.   /$5D                            {         POP     BP}
  788.                                   {;}
  789.                                   {Exit:}
  790. );
  791.  
  792. END   (* Change_Attributes *);
  793.  
  794. (*----------------------------------------------------------------------*)
  795. (*    Set_Text_Attributes --- Set text attributes for portion of screen *)
  796. (*----------------------------------------------------------------------*)
  797.  
  798. PROCEDURE Set_Text_Attributes( X1, Y1, X2, Y2, FG, BG : INTEGER );
  799.  
  800. (*----------------------------------------------------------------------*)
  801. (*                                                                      *)
  802. (*     Procedure:  Set_Text_Attributes                                  *)
  803. (*                                                                      *)
  804. (*     Purpose:    Sets text attributes for portion of screen           *)
  805. (*                                                                      *)
  806. (*     Calling Sequence:                                                *)
  807. (*                                                                      *)
  808. (*        Set_Text_Attributes( X1, Y2, X2, Y2, FG, BG: INTEGER );       *)
  809. (*                                                                      *)
  810. (*           (X1,Y1);(X2,Y2) --- region to set attributes in            *)
  811. (*           FG --- ForeGround color                                    *)
  812. (*           BG --- BackGround color                                    *)
  813. (*                                                                      *)
  814. (*----------------------------------------------------------------------*)
  815.  
  816. VAR
  817.    Attrib: INTEGER;
  818.    SaveX : INTEGER;
  819.    SaveY : INTEGER;
  820.    I     : INTEGER;
  821.    N     : INTEGER;
  822.  
  823. BEGIN  (* Set_Text_Attributes *)
  824.                                    (* Get # attribs per line to change *)
  825.    N := ( X2 - X1 + 1 );
  826.  
  827.    IF ( N <= 0 ) THEN EXIT;
  828.                                    (* Get new text attribute *)
  829.  
  830.    Attrib := ( BG AND 7 ) SHL 4 + FG;
  831.  
  832.                                    (* Save current position  *)
  833.    SaveX := WhereX;
  834.    SaveY := WhereY;
  835.                                    (* Turn off the cursor      *)
  836.    CursorOff;
  837.                                    (* Freeze screen for DoubleDos *)
  838.  
  839.    IF ( MultiTasker = DoubleDos ) THEN
  840.       BEGIN
  841.          TurnOffTimeSharing;
  842.          Get_Screen_Address( DesqView_Screen );
  843.       END;
  844.                                    (* Loop over area to change *)
  845.    FOR I := Y1 TO Y2 DO
  846.       Change_Attributes( N, X1, I, Attrib );
  847.  
  848.                                    (* Unfreeze screen in DoubleDos *)
  849.  
  850.    IF ( MultiTasker = DoubleDos ) THEN
  851.       TurnOnTimeSharing
  852.                                    (* Synchronize screen for TopView *)
  853.  
  854.    ELSE IF ( MultiTasker = TopView ) THEN
  855.       Sync_Screen( ( Y1 - 1  ) * Max_Screen_Col * 2 + 1,
  856.                    ( Y2 - Y1 ) * Max_Screen_Col );
  857.  
  858.                                    (* Restore old location *)
  859.    GoToXY( SaveX, SaveY );
  860.                                    (* Turn on the cursor   *)
  861.    CursorOn;
  862.  
  863. END    (* Set_Text_Attributes *);
  864.  
  865. (*----------------------------------------------------------------------*)
  866. (*                 Screen Manipulation Routines                         *)
  867. (*----------------------------------------------------------------------*)
  868. (*                                                                      *)
  869. (*   These routines save and restore screen images in support of the    *)
  870. (*   windowing facility.  Also, the current screen image can be printed *)
  871. (*   and text extracted from the screen memory.                         *)
  872. (*                                                                      *)
  873. (*----------------------------------------------------------------------*)
  874.  
  875. (*----------------------------------------------------------------------*)
  876. (*         ReadCXY --- Read character/attribute from screen             *)
  877. (*----------------------------------------------------------------------*)
  878.  
  879. PROCEDURE ReadCXY( VAR C     (*  : CHAR *);
  880.                        X         : INTEGER;
  881.                        Y         : INTEGER;
  882.                    VAR Color (*  : BYTE *) );
  883.  
  884. (*----------------------------------------------------------------------*)
  885. (*                                                                      *)
  886. (*     Procedure:  ReadCXY                                              *)
  887. (*                                                                      *)
  888. (*     Purpose:    Reads a character from specified row and column      *)
  889. (*                 position on screen.                                  *)
  890. (*                                                                      *)
  891. (*     Calling Sequence:                                                *)
  892. (*                                                                      *)
  893. (*        ReadCXY( VAR C: CHAR; X: INTEGER; Y: INTEGER;                 *)
  894. (*                 VAR Color: INTEGER );                                *)
  895. (*                                                                      *)
  896. (*           C      --- Character picked up                             *)
  897. (*           X      --- Column position to read character               *)
  898. (*           Y      --- Column position to read character               *)
  899. (*           Color  --- Attribute of character                          *)
  900. (*                                                                      *)
  901. (*----------------------------------------------------------------------*)
  902.  
  903. VAR
  904.    SaveXY: INTEGER;
  905.  
  906. BEGIN (* ReadCXY *)
  907.  
  908. INLINE(
  909.                          {;}
  910.   $B4/$03                {          MOV    AH,3              ;Get current cursor position}
  911.   /$B7/$00               {          MOV    BH,0}
  912.   /$CD/$10               {          INT    $10}
  913.                          {;}
  914.   /$89/$96/>SAVEXY       {          MOV    [BP+>SaveXY],DX   ;Save current coordinates}
  915.                          {;}
  916.   /$B4/$02               {          MOV    AH,2              ;Position cursor function}
  917.   /$B7/$00               {          MOV    BH,0}
  918.   /$8A/$76/<Y            {          MOV    DH,[BP+<Y]        ;Get row}
  919.   /$FE/$CE               {          DEC    DH}
  920.   /$8A/$56/<X            {          MOV    DL,[BP+<X]        ;Get column}
  921.   /$FE/$CA               {          DEC    DL}
  922.   /$CD/$10               {          INT    $10               ;Position cursor}
  923.                          {;}
  924.   /$B4/$08               {          MOV    AH,8              ;Get character and attribute}
  925.   /$B7/$00               {          MOV    BH,0}
  926.   /$CD/$10               {          INT    $10}
  927.                          {;}
  928.   /$C4/$7E/<C            {          LES    DI,[BP+<C]        ;Get address of where to store character}
  929.   /$26/$88/$05           {      ES: MOV    [DI],AL           ;and store it}
  930.                          {;}
  931.   /$C4/$7E/<COLOR        {          LES    DI,[BP+<Color]    ;Get address of where to store attribute}
  932.   /$26/$88/$25           {      ES: MOV    [DI],AH           ;and store it}
  933.                          {;}
  934.   /$B4/$02               {          MOV    AH,2              ;Position cursor function}
  935.   /$B7/$00               {          MOV    BH,0}
  936.   /$8B/$96/>SAVEXY       {          MOV    DX,[BP+>SaveXY]   ;Get back previous position}
  937.   /$CD/$10               {          INT    $10               ;Position cursor}
  938.                          {;}
  939. );
  940.  
  941. END   (* ReadCXY *);
  942.  
  943. (*----------------------------------------------------------------------*)
  944. (*           MoveToScreen  ---  Move data to screen memory              *)
  945. (*----------------------------------------------------------------------*)
  946.  
  947. PROCEDURE MoveToScreen( VAR Source, Dest; SLen: INTEGER );
  948.  
  949. (*----------------------------------------------------------------------*)
  950. (*                                                                      *)
  951. (*     Procedure:  MoveToScreen                                         *)
  952. (*                                                                      *)
  953. (*     Purpose:    Moves bytes to screen memory at specified offset     *)
  954. (*                 with retrace locks.                                  *)
  955. (*                                                                      *)
  956. (*     Calling Sequence:                                                *)
  957. (*                                                                      *)
  958. (*        MoveToScreen( VAR Source, Dest; SLen: INTEGER );              *)
  959. (*                                                                      *)
  960. (*           Source --- Data to be moved to screen                      *)
  961. (*           Dest   --- Offset in screen to start storing SData         *)
  962. (*           SLen   --- Number of words to move                         *)
  963. (*                                                                      *)
  964. (*     Calls:   None                                                    *)
  965. (*                                                                      *)
  966. (*----------------------------------------------------------------------*)
  967.  
  968. BEGIN (* MoveToScreen *)
  969.  
  970. INLINE(
  971.   $1E                    {         PUSH  DS                     ;Save DS}
  972.                          {;}
  973.   /$8B/$4E/<SLEN         {         MOV   CX,[BP+<SLen]          ;CX = Length(Source)}
  974.   /$E3/$1E               {         JCXZ  Return                 ;If string empty, Return}
  975.                          {;}
  976.   /$C4/$7E/<DEST         {         LES   DI,[BP+<Dest]          ;ES:DI points to destination}
  977.   /$C5/$76/<SOURCE       {         LDS   SI,[BP+<Source]        ;DS:SI points to source}
  978.   /$FC                   {         CLD                          ;Forward direction}
  979.                          {;}
  980.   /$BA/>CRT_STATUS       {         MOV   DX,>CRT_Status         ;Point DX to CGA status port}
  981.                          {;}
  982.   /$AD                   {GetNext: LODSW                        ;Load next character/attr into AX}
  983.   /$89/$C3               {         MOV   BX,AX                  ;Store video word in BX}
  984.                          {;}
  985.   /$EC                   {WaitNoH: IN    AL,DX                  ;Get 6845 status}
  986.   /$A8/$01               {         TEST  AL,1                   ;Wait for horizontal}
  987.   /$75/$FB               {         JNZ   WaitNoH                ; retrace to finish}
  988.                          {;}
  989.   /$FA                   {         CLI                          ;Turn off interrupts}
  990.   /$EC                   {WaitH:   IN    AL,DX                  ;Get 6845 status again}
  991.   /$A8/$01               {         TEST  AL,1                   ;Wait for horizontal retrace}
  992.   /$74/$FB               {         JZ    WaitH                  ; to start}
  993.                          {;}
  994.   /$89/$D8               {Store:   MOV   AX,BX                  ;Restore attribute}
  995.   /$AB                   {         STOSW                        ; and then to screen}
  996.   /$FB                   {         STI                          ;Allow interrupts}
  997.                          {;}
  998.   /$E2/$EC               {         LOOP  GetNext                ;Get next character}
  999.                          {;}
  1000.   /$1F                   {Return:  POP   DS                     ;Restore DS}
  1001. );
  1002.  
  1003. END   (* MoveToScreen *);
  1004.  
  1005. (*----------------------------------------------------------------------*)
  1006. (*           MoveFromScreen  ---  Move data from screen memory          *)
  1007. (*----------------------------------------------------------------------*)
  1008.  
  1009. PROCEDURE MoveFromScreen( VAR Source, Dest; SLen: INTEGER );
  1010.  
  1011. (*----------------------------------------------------------------------*)
  1012. (*                                                                      *)
  1013. (*     Procedure:  MoveFromScreen                                       *)
  1014. (*                                                                      *)
  1015. (*     Purpose:    Moves bytes from screen memory at specified offset   *)
  1016. (*                 with retrace locks.                                  *)
  1017. (*                                                                      *)
  1018. (*     Calling Sequence:                                                *)
  1019. (*                                                                      *)
  1020. (*        MoveFromScreen( VAR Source, Dest; SLen: INTEGER );            *)
  1021. (*                                                                      *)
  1022. (*           Source --- Offset in screen to start at                    *)
  1023. (*           Dest   --- Receiving data area                             *)
  1024. (*           SLen   --- Number of words to move                         *)
  1025. (*                                                                      *)
  1026. (*     Calls:   None                                                    *)
  1027. (*                                                                      *)
  1028. (*----------------------------------------------------------------------*)
  1029.  
  1030. BEGIN (* MoveFromScreen *)
  1031.  
  1032. INLINE(
  1033.   $1E                    {         PUSH  DS                     ;Save DS}
  1034.                          {;}
  1035.   /$8B/$4E/<SLEN         {         MOV   CX,[BP+<SLen]          ;CX = Length(Source)}
  1036.   /$E3/$1A               {         JCXZ  Return                 ;If string empty, Return}
  1037.   /$C4/$7E/<DEST         {         LES   DI,[BP+<Dest]          ;ES:DI points to destination}
  1038.   /$C5/$76/<SOURCE       {         LDS   SI,[BP+<Source]        ;DS:SI points to source}
  1039.   /$FC                   {         CLD                          ;Forward direction}
  1040.   /$BA/>CRT_STATUS       {         MOV   DX,>CRT_Status         ;Point DX to CGA status port}
  1041.                          {;}
  1042.   /$EC                   {WaitNoH: IN    AL,DX                  ;Get 6845 status}
  1043.   /$A8/$01               {         TEST  AL,1                   ;Wait for horizontal}
  1044.   /$75/$FB               {         JNZ   WaitNoH                ; retrace to finish}
  1045.                          {;}
  1046.   /$FA                   {         CLI                          ;Turn off interrupts}
  1047.   /$EC                   {WaitH:   IN    AL,DX                  ;Get 6845 status again}
  1048.   /$A8/$01               {         TEST  AL,1                   ;Wait for horizontal retrace}
  1049.   /$74/$FB               {         JZ    WaitH                  ; to start}
  1050.                          {;}
  1051.   /$AD                   {         LODSW                        ;Get word from screen}
  1052.   /$FB                   {         STI                          ;Allow interrupts}
  1053.   /$AB                   {         STOSW                        ;Store in receiving data area}
  1054.   /$E2/$F0               {         LOOP  WaitNoH                ;Get next character}
  1055.                          {;}
  1056.   /$1F                   {Return:  POP   DS                     ;Restore DS}
  1057. );
  1058.  
  1059. END   (* MoveFromScreen *);
  1060.